home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jtextemacs.tcl < prev    next >
Encoding:
Text File  |  1995-02-05  |  7.9 KB  |  281 lines
  1. # jtextemacs.tcl - additional procedures for Emacs-like Text bindings
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5.  
  6. # TO DO:
  7. # ^L
  8. # sentence-manipulation stuff
  9. # case change commands, transposition commands
  10. # commands to do with mark?
  11. # word deletion - fix to use buffer
  12. # generalise movement to copying-to-cutbuffer and deletion
  13. # IMPROVE ENTRY BINDINGS
  14. # literal-insert for entry
  15.  
  16. ######################################################################
  17. # j:tb:emacs_init t - set emacs bindings up for widget $t (possibly "Text")
  18. ######################################################################
  19.  
  20. proc j:tb:emacs_init { {t Text} } {
  21.   global j_teb
  22.   set j_teb(cutbuffer) {}
  23.   set j_teb(dragscroll,txnd) 0
  24.   set j_teb(dragscroll,delay) 50
  25.   set j_teb(scanpaste_time) 0
  26.   set j_teb(scanpaste_paste) 1
  27.   
  28.   set j_teb(keymap,$t) emacs-normal
  29.   
  30.   # in tk4, we need to make sure tkTextBind is called _before_
  31.   #   j:tb:key_bind!
  32.   j:tk4 {tkTextBind Enter}
  33.   
  34.   j:tb:key_bind $t
  35.   j:tb:mouse_bind $t
  36.   
  37.   j:tkb:mkmap Text emacs-normal emacs-normal {
  38.     {Control-slash        j:tb:select_all}
  39.     {Control-backslash        j:tb:clear_selection}
  40.     
  41.     {Delete            j:tkb:delete_left}
  42.     {BackSpace            j:tkb:delete_left}
  43.     {Return            j:tkb:insert_newline}
  44.     
  45.     {Control-d            j:tkb:delete_right}
  46.     
  47.     {Up                j:tkb:up}
  48.     {Down            j:tkb:down}
  49.     {Left            j:tkb:left}
  50.     {Right            j:tkb:right}
  51.     
  52.     {Control-p            j:tkb:up}
  53.     {Control-n            j:tkb:down}
  54.     {Control-b            j:tkb:left}
  55.     {Control-f            j:tkb:right}
  56.     
  57.     {Home            j:tkb:bol}
  58.     {End            j:tkb:eol}
  59.     
  60.     {Control-a            j:tkb:bol}
  61.     {Control-e            j:tkb:eol}
  62.     
  63.     {Next            j:tkb:scroll_down}
  64.     {Prior            j:tkb:scroll_up}
  65.     
  66.     {Control-v            j:tkb:scroll_down}
  67.     
  68.     {Control-k            j:tkb:e:kill_line}
  69.     {Control-w            j:tkb:e:kill_region}
  70.     {Control-y            j:tkb:e:yank}
  71.  
  72.     {Control-i            j:tkb:self_insert}
  73.     {Control-j            j:tkb:self_insert}
  74.     {Control-h            j:tkb:delete_left}
  75.     
  76.     {Control-space        j:tkb:e:set_mark_command}
  77.     {Control-at            j:tkb:e:set_mark_command}
  78.     
  79.     {Control-g            j:tkb:clear_count}
  80.     
  81.     {1                j:tkb:self_insert_digit}
  82.     {2                j:tkb:self_insert_digit}
  83.     {3                j:tkb:self_insert_digit}
  84.     {4                j:tkb:self_insert_digit}
  85.     {5                j:tkb:self_insert_digit}
  86.     {6                j:tkb:self_insert_digit}
  87.     {7                j:tkb:self_insert_digit}
  88.     {8                j:tkb:self_insert_digit}
  89.     {9                j:tkb:self_insert_digit}
  90.     {0                j:tkb:self_insert_digit}
  91.     
  92.     {Control-u            j:tkb:e:generic_arg}
  93.     
  94.     {Control-q            j:tkb:new_mode emacs-literal}
  95.     {Control-x            j:tkb:new_mode emacs-control-x}
  96.     {Escape            j:tkb:new_mode emacs-escape}
  97.     
  98.     {Control-DEFAULT        j:tb:no_op}
  99.     {DEFAULT            j:tkb:self_insert}
  100.     {Shift-DEFAULT        j:tkb:self_insert}
  101.   }
  102.   
  103.   j:tkb:mkmap Text emacs-literal emacs-normal {
  104.     {DEFAULT            j:tkb:self_insert}
  105.     {Shift-DEFAULT        j:tkb:self_insert}
  106.     {Control-DEFAULT        j:tkb:self_insert}
  107.     {Meta-DEFAULT        j:tkb:self_insert}
  108.   }
  109.   
  110.   j:tkb:mkmap Text emacs-control-x emacs-normal {
  111.     {Control-g            j:tkb:clear_count}
  112.     {Control-x            j:tkb:e:exchange_point_and_mark}
  113.     
  114.     {DEFAULT            j:tkb:clear_count}
  115.     {Shift-DEFAULT        j:tkb:clear_count}
  116.     {Control-DEFAULT        j:tkb:clear_count}
  117.     {Meta-DEFAULT        j:tkb:clear_count}
  118.   }
  119.   
  120.   j:tkb:mkmap Text emacs-escape emacs-normal {
  121.     {less            j:tkb:bof}
  122.     {greater            j:tkb:eof}
  123.     {b                j:tkb:word_left}
  124.     {f                j:tkb:word_right}
  125.     {v                j:tkb:scroll_up}
  126.     {Delete            j:tkb:delete_left_word}
  127.     {BackSpace            j:tkb:delete_left_word}
  128.     {d                j:tkb:delete_right_word}
  129.     
  130.     {1                j:tkb:start_number}
  131.     {2                j:tkb:start_number}
  132.     {3                j:tkb:start_number}
  133.     {4                j:tkb:start_number}
  134.     {5                j:tkb:start_number}
  135.     {6                j:tkb:start_number}
  136.     {7                j:tkb:start_number}
  137.     {8                j:tkb:start_number}
  138.     {9                j:tkb:start_number}
  139.     {0                j:tkb:start_number}
  140.     
  141.     {Control-g            j:tkb:clear_count}
  142.     
  143.     {DEFAULT            j:tb:no_op}
  144.     {Shift-DEFAULT        j:tb:no_op}
  145.     {Control-DEFAULT        j:tb:no_op}
  146.     {Meta-DEFAULT        j:tb:no_op}
  147.   }
  148. }
  149.  
  150. ######################################################################
  151. # j:tkb:e:generic_arg - start generic argument
  152. #   kind of clumsy: set repeat count to four, or multiply by four
  153. ######################################################################
  154.  
  155. proc j:tkb:e:generic_arg { W args } {
  156.   global j_teb
  157.   
  158.   # set up prefix/repeat information if this widget hasn't been used yet
  159.   if {! [info exists j_teb(prefix,$W)]} {
  160.     set j_teb(prefix,$W) 0
  161.   }
  162.   if {! [info exists j_teb(repeat_count,$W)]} {
  163.     set j_teb(repeat_count,$W) 1
  164.   }
  165.  
  166.   if {$j_teb(prefix,$W) == 1 && $j_teb(repeat_count,$W) == 0} {
  167.     set j_teb(repeat_count,$W) 16        ;# ^U^U -> 4*4
  168.     return
  169.   }
  170.   if {$j_teb(prefix,$W) == 0} {
  171.     set j_teb(prefix,$W) 1
  172.     set j_teb(repeat_count,$W) 0        ;# special; -> 4 in repeatable
  173.     return
  174.   }
  175.   set j_teb(repeat_count,$W) [expr {$j_teb(repeat_count,$W)*4}]
  176. }
  177.  
  178. ######################################################################
  179. ###  TEXT EMACS DELETION COMMANDS
  180. ######################################################################
  181.  
  182. # j:tkb:e:kill_line W K A - delete insert to end-of-line, setting cutbuffer
  183. #   (arg handled by called procedure)
  184. proc j:tkb:e:kill_line { W K A } {
  185.   global j_teb
  186.   set j_teb(modified,$W) 1
  187.   
  188.   # set up prefix/repeat information if this widget hasn't been used yet
  189.   if {! [info exists j_teb(prefix,$W)]} {
  190.     set j_teb(prefix,$W) 0
  191.   }
  192.   if {! [info exists j_teb(repeat_count,$W)]} {
  193.     set j_teb(repeat_count,$W) 1
  194.   }
  195.  
  196.   # Append to cutbuffer if previous command was line-kill; otherwise
  197.   #   start with new cutbuffer:
  198.   set my_name [lindex [info level 0] 0]
  199.   if {! [string match $my_name $j_teb(last_command,$W)]} {
  200.     set j_teb(cutbuffer) {}
  201.   }
  202.   
  203.   # special-case prefix == 1 and repeat_count == 0 for Emacs ^U^U:
  204.   #
  205.   if {$j_teb(prefix,$W) == 1 && $j_teb(repeat_count,$W) == 0} {
  206.     set j_teb(repeat_count,$W) 4
  207.   }
  208.   
  209.   # if no argument, DON'T kill "\n" unless it's only thing at insert
  210.   #
  211.   if {$j_teb(repeat_count,$W) < 2} {
  212.     j:tkb:clear_count $W            ;# in case it's eg -1
  213.     if {[$W index insert] == [$W index {insert lineend}]} then {
  214.       append j_teb(cutbuffer) [$W get insert]
  215.       j:text:delete $W insert {insert + 1 char}
  216.     } else {
  217.       append j_teb(cutbuffer) [$W get insert {insert lineend}]
  218.       j:text:delete $W insert {insert lineend}
  219.     }
  220.   } else {
  221.     # with argument, kill that many lines (including "\n")
  222.     j:tkb:repeatable {
  223.       append j_teb(cutbuffer) [$W get insert {insert lineend + 1 char}]
  224.       j:text:delete $W insert {insert lineend + 1 char}
  225.     } $W
  226.   }
  227.   
  228.   set j_teb(repeat_count,$W) 1
  229. }
  230.  
  231. # j:tkb:e:kill_region W K A - delete selected region, setting cutbuffer
  232. ###   emacs region shouldn't be conflated with Text selection!
  233. proc j:tkb:e:kill_region { W K A } {
  234.   global j_teb
  235.   set j_teb(modified,$W) 1
  236.  
  237.   j:tkb:clear_count $W
  238.  
  239.   set j_teb(cutbuffer) {}
  240.   catch {
  241.     set j_teb(cutbuffer) [$W get sel.first sel.last]
  242.     j:text:delete $W sel.first sel.last
  243.   }
  244. }
  245.  
  246. # j:tkb:e:yank W K A - insert contents of cutbuffer
  247. ###   handling of argument needs changed---not count, but not ignored
  248. proc j:tkb:e:yank { W K A } {
  249.   global j_teb
  250.  
  251.   j:tkb:clear_count $W
  252.   
  253.   j:text:insert_string $W $j_teb(cutbuffer)
  254. }
  255.  
  256. ######################################################################
  257. ###  TEXT EMACS MARK COMMANDS
  258. ######################################################################
  259.  
  260. # j:tkb:e:set_mark_command W K A - set emacs mark at current insert point
  261. proc j:tkb:e:set_mark_command { W K A } {
  262.   $W mark set emacs_mark insert
  263. }
  264.  
  265. # j:tkb:e:exchange_point_and_mark W K A - swap insert point and emacs mark
  266. proc j:tkb:e:exchange_point_and_mark { W K A } {
  267.   if {[lsearch [$W mark names] emacs_mark] != -1} {
  268.     set mark [$W index emacs_mark]
  269.     $W mark set emacs_mark insert
  270.     j:tb:move $W $mark
  271.   } else {
  272.     error "The mark is not set in text widget $W."
  273.   }
  274. }
  275.  
  276. # deprecated alias for backwards-compatibility:
  277.  
  278. proc j:tb:emacs_bind { W } {
  279.   j:tb:emacs_init $W
  280. }
  281.